perm filename CODE4.OLD[P11,LCS] blob
sn#579533 filedate 1981-04-14 generic text, type T, neo UTF8
C****** CODE4.F4 DRAWS LINES, DASHES, ETC. *******
C TITLE ITMSUB
C INTERNAL ITMSUB
C EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.
C EXTERNAL DAT,RHORZ,CLEFS,PLTR,MIN,POSI,ALF,RDRAW,OLDTOP
C DEFINE R9 <.COMM.+=10 >↔ DEFINE R8<.COMM.+=9 >
C DEFINE J2 <.COMM.+3 >↔ DEFINE J10 <.COMM.+=31 >
C DEFINE J7 <.COMM.+=28 >
SUBROUTINE ITMSUB
IMPLICIT INTEGER(A-Q,S-Z)
REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1,XDIS
COMMON/STF/RSTFAC(0/7),RSTJ2/MIN/MINI,RMINI
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,RG,RH/BM/RA,RC,RJY
COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(R11,
1RJQ(9)),(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
C RDBR IS SPACER FOR DBL BAR.
RST7=RSTJ2*7.
RST18=RSTJ2*18.
C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
R3Q=R3
C NEXT DRAWS STRAIGHT LINES
RD=R4*RST7
RA=0
RX=RTF*RSTJ2+POS
J10=J10*DIS*RSTJ2
C THICKNESS DEPENDS ON FINAL SIZE FACTOR (DIS) AND STAFF SIZE.(???!!)
IF(J5.EQ.50.OR.J5.EQ.150)GO TO 300
C 150 IS FOR 'PARTS' FEATURE - PUTS CRESC. IN ALL.
IF(R6.NE.0)GO TO 401
IF(J7.NE.0)GO TO 401
C FOR BAR LINES
4000 JA=44
C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
DBR=0
IF(J4.LT.1000)GO TO 400
C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
DBR=J4/1000
IF(J5.NE.0)GO TO 1
IF(DBR.LT.2)GO TO 1
J5=1
IF(DBR.EQ.4)DBR=1
C FOR REPEAT DBL.BAR WITH P5=0
C P4=2000=DOTS ON RIGHT, =3000=BOTH SIDES
C =4000=DOTS ON LEFT
1 J4=J4-DBR*1000
C DBR=1 HEAVY BAR IS ON R
9400 RD=RDBR+RDBR*RSTJ2
C TO SPACE THIN BAR FROM HEAVY
IF(J5.EQ.0)GO TO 400
C NEXT ADDS REPEAT DOTS TO DBL BAR.
L=J4
RJ=L/100
IF(RJ.EQ.0)RJ=6.*RSTJ2
C HEAVY BAR WILL BE 5 LINES WIDE.
RZ=R3
J4=0
C MUST BE 0 FOR DOTS IN 'NOTWRT'
IF(DBR.NE.0)GO TO 2
IF(J5.GT.3)J5=3
DBR=J5
2 J5=0
C J5=1 RPT ↑, =2 RPT ↑, =3 RPT ↑
RJA=RD*2.
C TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
JY=DBR
IF(DBR.LT.2)GO TO 8400
R3=RJA+RJ+RZ
7400 DO 3400 K=J2,MOD(L,100)+J2-1
4 RSTJ2=RSTFAC(K)
POS=STFF(K)
R4=6
CALL CENTX
C SPACES DOTS OUT FROM BAR
CALL RDRAW(1,17.0,RDOT(4),RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
C /DAT/+=69 ;EXTENDED FOR +65 TO +69 1/78
C GO GET THE DOT
R4=8
CALL CENTX
3400 CALL RDRAW(1,17.0,RDOT(4),RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
JY=JY-1
IF(JY.LT.2)GO TO 4400
8400 R3=RZ-RJA-4.*RSTJ2
GO TO 7400
C DO I NEED ANY MORE RESETS????
4400 J4=L
J7=RJ*DIS
GO TO 5400
400 IF(J5.NE.0)GO TO 9400
K=J4/100
C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
J7=K*DIS
C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
C5400 L=MOD(J4,100)
C IF(J4.LT.0)J4=0
C ABOVE FOR INVIS. BARS (AT PRINT TIME)
5400 L=J4
IF(L.LT.0)L=0
L=MOD(L,100)
IF(L.NE.0)L=L-1
L=L+J2
C L=L+J2-1
C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
RA=RTF
IF(L.LE.7)GO TO 2400
L=7
RA=300.
C FOR EXTENDING BARS ABOVE STAFF 7
2400 OLDY=RSTFAC(L)
C SAVE IT FOR DBL RPT BAR.
RZ=R3Q
OLDY=STFF(L)+(RA+56.)*OLDY
1400 RA=1
IF(PLT.GE.0)GO TO 140
IF(J4.LT.0)RETURN
J7=J7+1
C DON'T PRINT INVIS BARS. (USED BY 'PAGE')
RA=XDIS
C BAR LINES PLOT AS DOUBLE THICKNESS
140 RJX=R3Q
42 CALL LINES(R3Q,RX,3)
RJ=-1.
RW=OLDY
406 CALL LINES(RJX,OLDY,2)
IF(J10.EQ.0)GO TO 411
C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
J7=J10
J10=0
RA=XDIS
411 IF(J7.GT.0)GO TO 409
IF(DBR.LE.0)RETURN
OLDY=RW
RA=RZ-RD
IF(DBR.NE.1)RA=RJX+RD-1.
R3Q=RA
DBR=DBR-2
GO TO 1400
409 IF(R6.EQ.0)GO TO 1402
C FOR 'HEAVY' LINE.
C P10 = NUM. OF ADDITIONAL LINES.
C ****** ONLY GOOD FOR SLOPE OF LESS THAN 45 DEG.
J7=J7-1
J10=J7
C GET SHIFT INCREMENT (DEPENDS ON FINAL SIZE)
RR=ABS(RX-OLDY)
C RR HAS AMOUNT OF Y SHIFT IN LINE
RQ=ABS(R3Q-RJX)
C RQ HAS AMOUNT OF X SHIFT IN LINE
RQ=RQ-RR
IF(RQ.GE.0)GO TO 1402
C MOVE RIGHT ONE SCAN LINE FOR NEXT VECTOR
R3Q=R3Q+RA
C R3Q AND RJX ARE THE 2 X COORDS.
GO TO 42
1402 RX=RX+RA
C MOVE UP ONE SCAN LINE FOR NEXT VECTOR
OLDY=OLDY+RA
C RX AND OLDY ARE THE 2 Y COORDS.
GO TO 42
C GO DRAW IT
402 RJX=RJX+RA
C HEAVIER BAR LINES
CALL LINES(RJX,OLDY,2)
J7=J7-1
OLDY=RW
IF(RJ.LT.0)OLDY=RX
RJ=-RJ
GO TO 406
C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
C FOR CRESC., DECRESC.
300 IF(R7.EQ.0)R7=2.3
IF(R7.EQ.-1.)R7=-2.3
RA=ABS(R7/2.0)*RST7
C AMOUNT OF SPREAD
RJ=R3Q
RX=RX-RST18+RD
IF(R8.NE.0)GO TO 302
C JUMP TO MAKE BOX
R6=RHORZ(R6)
IF(R7.LT.0)GO TO 301
RJ=R6
R6=R3Q
301 CALL LINX(RJ,RA+RX,R6,RX)
CALL LINES(RJ,RX-RA,2)
C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
IF(PLT.GE.0)RETURN
C THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
IF(J8.LT.0)RETURN
RX=RX+XDIS
J8=-1
C FOR DOUBLE THICKNESS
GO TO 301
302 R8=R8*RST7
R9=R9*RST7
IF(R9.EQ.0)R9=R8
C R9=0 MAKES SQUARE
R3=R3Q-R8/2.
RX=RX-R9/2.
OLDY=RX
IF(R11.NE.0)OLDY=OLDY+R11*RST7
C R11 IS OFFSET FOR PARALLELAGRAM
C DRAWS BOX, CENTER IS IN MIDDLE
C 4,POSI+=9,STF,NT#,50,0,0,,SIZ1↑BY NT#S↑,SIZ2
1302 CALL LINX(R3,RX,R3+R8,OLDY)
CALL LINES(R3+R8,OLDY+R9,2)
CALL LINES(R3,RX+R9,2)
CALL LINES(R3,RX,2)
IF(J10.EQ.0)RETURN
J10=J10-1
RJ=XDIS
R3=R3-RJ
R8=R8+RJ+RJ
RX=RX-RJ
OLDY=OLDY-RJ
R9=R9+RJ+RJ
GO TO 1302
C TO THICKEN BOXES.
1401 R4=2.0
C FOR HEAVY BRACK.
RA=RST7
RX=RX-RA
C THE BOTTOM
L=J4+J2-1
R6=RTF
IF(L.LE.7)GO TO 4401
L=7
R6=300.
4401 RA=STFF(L)
C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
RJY=RSTFAC(L)
OLDY=RA+(R6+63.)*RJY
C THE TOP
R5=9.5
GO TO 2401
C DASHES
401 POS=POS-RST18
IF(J7.LE.0)GO TO 407
IF(J7.EQ.4)GO TO 1401
IF(J7.NE.3)GO TO 4001
C NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
2401 JA=3
IF(J10.EQ.0)J10=6.*DIS*RSTJ2
C THICKNESS FOLLOWS PLOTTER SIZE AND STAFF SIZE
C DEFAULT VALUE FOR THICKNESS =6*SIZE FACTS.
R4=R4-RBR
J9=0
J5=35
C THE NUM FOR THE LITTLE END ITEMS
R6=3
R7=0
C DOES LOWER ONE FIRST. ITEM IS IN 'CLEFC.DMD' ON DAT.LCS
R8=0
C R8 MUST BE 0 FOR CLEFS (ELSE IT ACTIVATES THICKENER)
JZ8=J8
C SAVE J8 IN JZ8 (J8 WIPED OUT IN CLEFS)
IF(J8.NE.2)CALL CLEFS
C P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
R4=R5-RBR
R6=3
R7=-3
C TURNS IT UPSIDE DOWN.
IF(J7.NE.4)GO TO 3401
POS=RA
R4=R4*RJY/RSTJ2
C TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
3401 IF(JZ8.NE.1)CALL CLEFS
C JZ8 IS CURRENTLY J8 (INTEGER I.E.)
R3Q=R3Q-12.0*RSTJ2
IF(J7.NE.4)GO TO 407
J7=0
GO TO 140
4002 J5=5
C FOR CURVY BRACKET. P8 CAN CHANGE WIDTH.
J4=J4+J2-1
R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
C .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
C ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
C ***** USE P8 FOR WIDTH FACTOR!! *****
J8=0
P6=P8
P8=0
IF(R6.EQ.0)R6=1.+R6/20.
JA=3
R4=2.3
C BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*↑
CALL CLEFS
RETURN
4001 IF(J7.EQ.5)GO TO 4002
IF(R8.LE.0)R8=.8
C NO NEG. NUMBS!!!! 2/78
C P8 CAN SET SIZE OF DASH
RZ=5.96*RSTJ2
RJ=R8*RZ
RZ=R9*RZ
IF(R9.LE.0)RZ=RJ
C P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
R8=RJ
R9=RZ
RD=RD+POS
RJX=RD
RJY=RD
C =1 =DASHES, P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE SLOPE.
J6=ROFF(RHORZ(R6))
J3=J6-J3
RJ4=R5-R4
RA=J6
C SAVE FOR THICK LINES
C RA IS HORIZ. GOAL FOR DASHES
OLDY=POS+R5*RST7
IF(J4.EQ.0)GO TO 41
RH=OLDY-RD
C TOTAL HEIGHT DIFF.
RX=RA-R3
C TOTAL LENGTH DIFF.
RH=RH/RX
41 L=3
K=2
416 CALL LINES(R3Q,RD,L)
IF(J3.EQ.0)GO TO 412
C JUMP FOR VERT. DASH
IF(J3.GT.0)GO TO 422
IF(R3Q.LE.RA)GO TO 413
C THIS IF P6 IS LESS THAN P3
R3Q=R3Q-RJ
GO TO 423
422 IF(R3Q.GE.RA)GO TO 413
C JUMP IF ALL DONE
R3Q=R3Q+RJ
423 IF(J4.NE.0)RD=RJY+RH*(R3Q-R3)
C J4 HAS TILT(SEE I402 -)
C FINDS HEIGHT OF RIGHT SIDE OF SLOPE
414 CALL EXCH(L,K)
CALL EXCH(RJ,RZ)
C EXCH. SPACE AND DASH SIZE.
GO TO 416
412 IF(J4.GT.0)GO TO 424
IF(RD.LE.OLDY)GO TO 413
RD=RD-RJ
C THIS IF P5 IS LESS THAN P4.
GO TO 414
424 IF(RD.GE.OLDY)GO TO 413
C JUMP IF DONE
RD=RD+RJ
GO TO 414
413 IF(J10.GT.0)GO TO 420
IF(J11.EQ.0)RETURN
IF(J3)RJ=-RJ
IF(L.EQ.3)R3Q=R3Q-RJ
RX=R8
IF(J11.LT.0)RX=-RX
CALL LINX(R3Q,RD,R3Q,RD+RX)
C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
RETURN
C NEXT FOR THICK DASHES
420 J10=J10-1
RJ=XDIS
IF(J3.EQ.0)GO TO 415
R3Q=R3
RJY=RJY+RJ
RD=RJY
GO TO 417
415 R3Q=R3Q+RJ
RD=RJX
417 RJ=R8
RZ=R9
C FOR THICK DASHES.
GO TO 41
407 RX=RD+POS
OLDY=R5*RST7+POS
R8=ABS(R8)
C NO NEG, TOLERATED!!! 2/78
IF(J7.EQ.3)GO TO 140
CALL NOZERO(R9)
IF(J7.EQ.-1)GO TO 408
C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
RJX=IFIX(ROFF(RHORZ(R6)))
C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
IF(J7.EQ.0)GO TO 42
OLDY=R9*RST7+RX
CALL NOZERO(R8)
4041 RZ=RX
RH=OLDY
C SAVE FOR THICK WIGGLES
CALL LINES(R3Q,RX,3)
C DRAWS STRAIGHT LINES. ETC.
R9=R3Q
RJ=OLDY
RW=3.*RSTJ2*R8
RA=RW*2.5
C P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
404 R9=R9+RA
CALL LINES(R9,RJ,2)
R9=R9+RW
CALL LINES(R9,RJ,2)
405 CALL EXCH(RX,RJ)
IF(R9.LT.RJX)GO TO 404
IF(J10.LE.0)RETURN
OLDY=XDIS
RX=RZ+OLDY
OLDY=RH+OLDY
J10=J10-1
GO TO 4041
C P10= + NUM OF THICKNESSES TO WIGGLE
408 IF(RX.GT.OLDY)CALL EXCH(RX,OLDY)
RZ=R9*RSTJ2*5.96
C USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
CALL NOZERO(R8)
RD=R8*RST7*.5
RJ=RD
IF(RD.LT.1.)RD=1.
421 R9=RX
RW=R3Q
RA=RZ+R3Q
CALL LINES(RW,R9,3)
410 R9=R9+RJ
CALL LINES(RA,R9,2)
R9=R9+RD
CALL LINES(RA,R9,2)
CALL EXCH(RA,RW)
IF(R9.LT.OLDY)GO TO 410
IF(J10.LE.0)RETURN
R3Q=R3Q+XDIS
J10=J10-1
GO TO 421
C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
END